{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE RecursiveDo #-}
module Main where

import GHCJS.DOM
import GHCJS.DOM.Document hiding (click)
import GHCJS.DOM.Element (setAttribute, click)
import GHCJS.DOM.Node
import GHCJS.DOM.EventM
import GHCJS.DOM.WebGLRenderingContextBase
import GHCJS.DOM.HTMLCanvasElement (getContext)
import GHCJS.DOM.Types hiding (Text)
import Data.FileEmbed (embedFile)
import Data.Text.Encoding (decodeUtf8)
import Data.Text (Text)
import Data.IORef
import Control.Monad (forM_, void)
import Data.Coerce (coerce)
import Data.StateVar

import GHCJS.DOM.Window (requestAnimationFrame)
import GHCJS.DOM.RequestAnimationFrameCallback (newRequestAnimationFrameCallback)

main :: IO ()
main = runWebGUI $ \win -> do
  enableInspector win
  Just doc <- webViewGetDomDocument win
  Just body <- getBody doc
  Just canvas <- createElement doc (Just "canvas")
  setAttribute canvas "width" "400"
  setAttribute canvas "height" "400"
  _ <- appendChild body (Just canvas)

  gl <- WebGLRenderingContextBase <$> getContext (coerce canvas) "webgl"

  program <- initShader gl
  uPointSize <- getUniformLocation gl program "u_PointSize"
  uniform1f gl uPointSize 10.0
  aPosition <- getAttribLocation gl program "a_Position"

  position <- newIORef 0.0
  let draw = do
        position $~ (+0.001)
        pos <- get position
        vertexAttrib3f gl (fromIntegral aPosition) pos 0.0 0.0
        clear gl COLOR_BUFFER_BIT
        drawArrays gl POINTS 0 1

      go = do
        rec cb <- newRequestAnimationFrameCallback $ \_ -> do
              draw
              void next

            let next = requestAnimationFrame win (Just cb)
        void next
  clearColor gl 0.0 0.0 0.0 1.0
  go

vertShaderSource :: Text
vertShaderSource = decodeUtf8 $(embedFile "shader/graph.vert")

fragShaderSource :: Text
fragShaderSource = decodeUtf8 $(embedFile "shader/graph.frag")

initShader :: IsWebGLRenderingContextBase self => self -> IO (Maybe WebGLProgram)
initShader gl = do
  frg <- createShader gl FRAGMENT_SHADER
  shaderSource gl frg fragShaderSource
  compileShader gl frg

  vert <- createShader gl VERTEX_SHADER
  shaderSource gl vert vertShaderSource
  compileShader gl vert

  prog <- createProgram gl
  attachShader gl prog frg
  attachShader gl prog vert
  linkProgram gl prog
  useProgram gl prog
  return prog
